home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / [!!!!!__XT183827192005.psc / Class Modules / clsGDI.cls next >
Text File  |  2004-10-25  |  4KB  |  154 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsGDI"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' On 22nd Oct 2004
  16. ' By Neeraj Agrawal nja91@yahoo.com , neeraj_agrawal_ind@rediffmail.com
  17.  
  18. 'clsGDI: GDI class used to store various Device context and Bitmap objects
  19. '        Used for transaparent drawing of images (using mask color)
  20.  
  21.  
  22. 'The main image which is to be drawn transparantly
  23. Public Property Get Image() As Long
  24.   Image = m_lhBmpImage
  25. End Property
  26.  
  27. Public Sub DrawImag Let Image(ByVal lhWndNewImage As Long)
  28.   
  29.   
  30.  
  31. End Property
  32.  
  33. Public Property Get MaskDC() As Long
  34.   MaskDC = m_lhDCMask
  35. End Property
  36.  
  37. Public Property Get ImageDC() As Long
  38.   ImageDC = m_lhDCImage
  39. End Property
  40.  
  41. Public Sub InitMe(hdc As Long, lMaskColor As Long)
  42.   m_lhDCImage = CreateCompatibleDC(hdc)
  43.   m_lhDCMask = CreateCompatibleDC(0)
  44.   m_lMaskColor = lMaskColor
  45. End Sub
  46.  
  47. Private Sub ReleaseBasicDCs()
  48.   Dim lTmp As Long
  49.   If m_lhBmpImageOld <> 0 Then
  50.     'Select the default bitmap first
  51.     lTmp = SelectObject(m_lhDCImage, m_lhBmpImageOld)
  52.     
  53.     
  54.     'If lTmp <> 0 Then
  55.     '  DeleteObject (lTmp)   'delete existing bitmap
  56.     'End If
  57.   End If
  58.   Call DeleteDC(m_lhDCImage)
  59.   
  60.   
  61.   If m_lhBmpMaskOld <> 0 Then
  62.     'Select the default bitmap first
  63.     lTmp = SelectObject(m_lhDCMask, m_lhBmpMaskOld)
  64.     
  65.     'If lTmp <> 0 Then
  66.     '  DeleteObject (lTmp)   'delete existing bitmap
  67.     'End If
  68.   End If
  69.   Call DeleteDC(m_lhDCMask)
  70.   
  71. End Sub
  72.  
  73. Public Sub DrawImage(lDestHDC As Long, lhBmp As Long, lTransColor As Long, iLeft As Integer, iTop As Integer, iWidth As Integer, iHeight As Integer)
  74.   Dim lhDCImage As Long
  75.   Dim lhBmpImageOld As Long
  76.   Dim lhDCMask As Long
  77.   Dim lhBmpMask As Long
  78.   Dim lhBmpMaskOld As Long
  79.   Dim lhDCTemp As Long
  80.   Dim lhBmpTemp As Long
  81.   Dim lhBmpTempOld As Long
  82.   
  83.   Dim lTmp As Long
  84.   Dim utBitmap As BITMAP
  85.   Dim lOldColor As Long
  86.   
  87.   
  88.   '----------- For Image DC ------------
  89.   
  90.   lhDCImage = CreateCompatibleDC(lDestHDC)
  91.   
  92.   'Select the bitmap to be drawn into the DC
  93.   m_lhBmpImageOld = SelectObject(lhDCImage, lhBmp)
  94.   
  95.   'Get Bitmap Dimensions
  96.   Call GetObjectA(lhBmp, Len(utBitmap), utBitmap)
  97.   
  98.   '------------ For Mask DC -----------
  99.  
  100.   lhDCMask = CreateCompatibleDC(0)
  101.   lhBmpMask = CreateCompatibleBitmap(lhDCMask, utBitmap.bmWidth, utBitmap.bmHeight)
  102.     
  103.     'Select the new bitmap into the DC
  104.   lhBmpMaskOld = SelectObject(lhDCMask, lhBmpMask)
  105.   
  106.   '------------ For Temp DC --------------
  107.  
  108.   lhDCTemp = CreateCompatibleDC(0)
  109.   lhBmpTemp = CreateCompatibleBitmap(lhDCTemp, utBitmap.bmWidth, utBitmap.bmHeight)
  110.   
  111.   'Select the new bitmap into the DC
  112.   lhBmpTempOld = SelectObject(lhDCTemp, lTransColor)
  113.   
  114.   '-------------------------------------------
  115.   
  116.   'Now Perform BitOperations
  117.   
  118.   lOldColor = SetBkColor(lhDCImage, lTransColor)
  119.   
  120.   Call BitBlt(lhDCTemp, 0, 0, utBitmap.bmWidth, utBitmap.bmHeight, lhDCImage, 0, 0, SRCCOPY)
  121.   
  122.   Call SetBkColor(lhDCImage, lOldColor)
  123.   
  124.   Call BitBlt(lhDCImage, 0, 0, utBitmap.bmWidth, utBitmap.bmHeight, lhDCTemp, 0, 0, SRCPAINT)
  125.   
  126.   Call BitBlt(lhDCMask, 0, 0, utBitmap.bmWidth, utBitmap.bmHeight, lhDCImage, 0, 0, WHITENESS)
  127.   
  128.   Call BitBlt(lhDCMask, 0, 0, utBitmap.bmWidth, utBitmap.bmHeight, lhDCTemp, 0, 0, SRCINVERT)
  129.      
  130.      
  131.   lOldColor = SetBkColor(lDestHDC, &HFFFFFF)
  132.   
  133.   Call BitBlt(lDestHDC, iLeft, iTop, iWidth, iHeight, lhDCMask, 0, 0, SRCPAINT)
  134.   
  135.   Call BitBlt(lDestHDC, iLeft, iTop, iWidth, iHeight, lhDCImage, 0, 0, SRCAND)
  136.  
  137.   Call SetBkColor(lDestHDC, lOldColor)
  138.   
  139.   'free the resources
  140.   lTmp = SelectObject(lhDCTemp, lhBmpTempOld)
  141.   DeleteObject (lTmp)
  142.   DeleteDC (lhDCTemp)
  143.   
  144.   'free the resources
  145.   lTmp = SelectObject(lhDCMask, lhBmpMaskOld)
  146.   DeleteObject (lTmp)
  147.   DeleteDC (lhDCMask)
  148.   
  149.   'free the resources
  150.   lTmp = SelectObject(lhDCImage, lhBmpImageOld)
  151.   DeleteDC (lhDCTemp)
  152. End Sub
  153.  
  154.